home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / thinkMenu.tcl < prev    next >
Encoding:
Text File  |  1997-12-10  |  8.1 KB  |  323 lines  |  [TEXT/ALFA]
  1. # (nowrap)
  2.  
  3. alpha::menu thinkMenu 1.0 "•300"
  4.  
  5. proc thinkMenu {} {}
  6.  
  7. # The menu
  8. menu -n $thinkMenu {
  9.     "/S<O<Uthink"
  10.     "openHeader"
  11.     "menu -n thinkFlags {}"
  12.     "createThinkFileset"
  13.     "(-"
  14.     "/K<O<Ucompile"
  15.     "checkSyntax"
  16.     "/T<O<UsearchNextFile"
  17.     "(-"
  18.     "add"
  19.     "addAndCompile"
  20.     "(-"
  21.     "disassemble"
  22.     "preprocess"
  23.     "precompile"
  24.     "(-"
  25.     "bringUpToDate"
  26.     "/\\<O<Umake"
  27.     "(-"
  28.     "/I<O<Udebug"
  29.     "/R<O<Urun"
  30. }
  31.  
  32.  
  33. # The following flags affect Think's "Run" command.
  34. # THINK will crash if you set the debugger flag and your 
  35. # project does not have debugging information. 
  36. if {![info exists thinkdebugger]}     {set thinkdebugger     0}
  37. if {![info exists thinkgo]}         {set thinkgo         1}
  38. if {![info exists thinksaveDirty]}     {set thinksaveDirty    1}
  39. if {![info exists thinkupdate]}     {set thinkupdate     1}
  40.  
  41. menu -n thinkFlags -p thinkFlagsProc {"debugger" "go" "saveDirty" "update"}
  42. markMenuItem thinkFlags debugger     $thinkdebugger
  43. markMenuItem thinkFlags go             $thinkgo
  44. markMenuItem thinkFlags saveDirty    $thinksaveDirty
  45. markMenuItem thinkFlags update         $thinkupdate
  46.  
  47. proc thinkFlagsProc {menu item} {
  48.     global think$item modifiedVars
  49.     
  50.     set think$item [expr -1 * ([set think$item] - 1)]
  51.     markMenuItem thinkFlags $item [set think$item]
  52.     lappend modifiedVars think$item
  53. }
  54.  
  55. set THINK "THINK Project Manager"
  56. #set THINK "AEvent Display 1.3"
  57.  
  58.  
  59. proc thinkNumFiles {} {
  60.     global THINK
  61.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  62.     if {[regexp {[0-9]+} $str mtch]} {
  63.         return $mtch
  64.     } else {
  65.         error "Bad numfiles"
  66.     }
  67. }
  68.  
  69.  
  70.  
  71. # Get list of files in current project.
  72. proc projectFileList args {
  73.     global SymCompSig
  74.     watchCursor
  75.     app::launchBack $SymCompSig
  76.     set num [thinkNumFiles]
  77.     set files {}
  78.  
  79.     for {set i 1} {$i<=$num} {incr i} {
  80.         set f [thinkFileName $i]
  81.         if {[getFileType $f] == "TEXT"} {
  82.             lappend files $f
  83.         }
  84.     }
  85.  
  86.     return $files
  87. }
  88.  
  89.  
  90.  
  91.  
  92. #================================================================================
  93.  
  94.  
  95. proc think {} {
  96.     global SymCompSig
  97.     app::launchFore $SymCompSig
  98. }
  99.  
  100. proc searchNextFile {} {
  101.     thinkFinf
  102. }
  103.  
  104.  
  105.  
  106. #===========================================================================
  107. # Add fileset.
  108. #===========================================================================
  109. proc createThinkFileset {} {
  110.     global gfileSets gfileSetsType
  111.     
  112.     set name [prompt "Fileset name? " "THINK"]
  113.     set gfileSets($name) [lsort -command sortByTail [projectFileList]]
  114.     set gfileSetsType($name) think
  115.  
  116.     if {[askyesno "Save project fileset?"] == "yes"} {
  117.         addArrDef gfileSets $name  $gfileSets($name)
  118.     }
  119.     return $name
  120. }
  121.  
  122. #================================================================================
  123.  
  124. proc compile {} {
  125.     sendCompileEvent CMPL "-r"
  126. }
  127.  
  128. proc checkSyntax {} {
  129.     sendCompileEvent SNTX "-q"
  130. }
  131.  
  132. proc disassemble {} {
  133.     global THINK ALPHA SymCompSig
  134.     getApplSig "Please locate $THINK" SymCompSig
  135.     set tname [file tail [app::launchFore $SymCompSig]]
  136.     set name [win::Current]
  137.     set res [AEBuild -t 7200 -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
  138.     switchTo $ALPHA
  139.     new -n "* [file root [file tail $name]].asm *"
  140.     regexp {“.*”} $res text
  141.     insertText [string trim $text {“”}]
  142.     setWinInfo dirty 0
  143.     goto 0
  144. }
  145.  
  146. proc preprocess {} {
  147.     global THINK ALPHA SymCompSig
  148.     getApplSig "Please locate $THINK" SymCompSig
  149.     set tname [file tail [app::launchFore $SymCompSig]]
  150.     set name [win::Current]
  151.     set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
  152.     switchTo $ALPHA
  153.     new -n "* Preprocessed '[file tail $name]' *"
  154.     regexp {“.*”} $res text
  155.     insertText [string trim $text {“”}]
  156. }
  157.  
  158.  
  159. proc sendCompileEvent {event arg} {
  160.     global THINK ALPHA SymCompSig
  161.  
  162.     getApplSig "Please locate $THINK" SymCompSig
  163.     set tname [file tail [app::launchFore $SymCompSig]]
  164.     set name [win::Current]
  165.     if {[string length $arg]} {
  166.         set err [catch {AEBuild -t 7200 $arg $tname KAHL  $event "----" [fileObject $name]} res]
  167.     } else {
  168.         set err [catch {AEBuild -t 7200 $tname KAHL  $event "----" [fileObject $name]} res]
  169.     }
  170.     if (!$err) {
  171.         set err [catch {switchTo $ALPHA} res]
  172.     }
  173.     if ($err) {
  174.         message $res
  175.     } else {
  176.         return $res
  177.     }
  178. }
  179.  
  180.  
  181. proc add {} {
  182.     global THINK
  183.     set fname [win::Current]
  184.     AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
  185. }
  186.  
  187. proc addAndCompile {} {
  188.     add
  189.     compile
  190. }
  191.  
  192.  
  193. proc precompile {} {
  194.     sendCompileEvent PCMP ""
  195. }
  196.  
  197. proc bringUpToDate {} {
  198.     global THINK ALPHA SymCompSig
  199.     getApplSig "Please locate $THINK" SymCompSig
  200.     set name [file tail [app::launchFore $SymCompSig]]
  201.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  202.     switchTo $ALPHA
  203.     return $res
  204. }
  205.  
  206. proc make {} {
  207.     global THINK ALPHA SymCompSig
  208.     getApplSig "Please locate $THINK" SymCompSig
  209.     set name [file tail [app::launchFore $SymCompSig]]
  210.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  211. }
  212.  
  213. proc run {} {
  214.     global THINK thinkdebugger thinkgo thinksaveDirty thinkupdate SymCompSig
  215.     
  216.     set dbug [expr {$thinkdebugger ? "bool(«01»)" : "bool(«00»)"}]
  217.     set go [expr {$thinkgo ? "bool(«01»)" : "bool(«00»)"}]
  218.     set update [expr {$thinkupdate ? "'yes '" : "'no  '"}]
  219.     set dirty [expr {$thinksaveDirty ? "'yes '" : "'no  '"}]
  220.     getApplSig "Please locate $THINK" SymCompSig
  221.     set name [file tail [app::launchFore $SymCompSig]]
  222.     if {[catch {AEBuild -q $name KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $update "savo" $dirty} res]} {
  223.         message $res
  224.     }
  225. }
  226.  
  227. proc debug {} {
  228.     global THINK 
  229.     switchTo '◊LSD'
  230.     set fname [win::Current]
  231.     set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
  232.     if {[catch {AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" } res]} {
  233.         message $res
  234.     }
  235. }
  236.  
  237. proc cnt {} {
  238.     global THINK
  239.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  240. }
  241.  
  242. proc thinkFileName {arg} {
  243.     global THINK
  244.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'indx',\ seld:} $arg {\},\ form:'prop',\ seld:type('FSS\ ')\}}] ""]
  245.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  246.     regexp {«.*»} $blah blah
  247.     return [specToPathName [string trim $blah {«»}]]
  248. }
  249.  
  250. proc thinkInclude {name} {
  251.     global THINK thinkpaths
  252.     if {[info exists thinkpaths]} {unset thinkpaths}
  253.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'name', seld:“} [file tail $name] {”\},\ form:'prop',\ seld:type('INCL')\}}] ""]
  254.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  255.     if {![regexp {«} $blah]} {return {{(No includes}}}
  256.     regsub -all {»[^«]*«} $blah { } raw
  257.     regsub {[^«]*«} $raw {} raw
  258.     regsub {».*} $raw {} raw
  259.     foreach f $raw {
  260.         set path [specToPathName $f]
  261.         set tl [file tail $path]
  262.         set thinkpaths($tl) $path
  263.         lappend names $tl
  264.     }
  265.     return [lsort -ignore $names]
  266. }
  267.  
  268. # Called by Alpha to get list of include files for popup.
  269. proc thinkGetIncludeFiles {} {
  270.     if {[catch {thinkInclude [lindex [winNames] 0]} ret]} {
  271.         return {{(* THINK not running *}}
  272.     }
  273.     return $ret
  274. }
  275.  
  276. # Called by Alpha to edit result of popup
  277. proc thinkEditIncludeFile {name} {
  278.     global thinkpaths
  279.     
  280.     edit $thinkpaths($name)
  281. }
  282.  
  283. proc openHeader {} {
  284.     global thinkpaths
  285.  
  286.     set name [lindex [winNames] 0]
  287.     if {![string length $name]} return
  288.     if {[catch {thinkInclude $name} names]} {
  289.         message "Think not running!" 
  290.         beep
  291.         return
  292.     }
  293.     if {![string length $name] || [string match {(*} [lindex $names 0]]} {
  294.         message "No headers."
  295.         beep
  296.         return
  297.     }
  298.     set res [listpick -p {Include File?} $names]
  299.     if {[string length $res]} {edit $thinkpaths($res)}
  300. }
  301.         
  302.  
  303. #================================================================================
  304.         
  305. proc handleThinkReply { l } {
  306.     global thinkErrors teIndex ALPHA tileLeft tileTop tileWidth tileHeight win::Modes terrMenu errorHeight
  307.     set thinkErrors $l
  308.     switchTo $ALPHA
  309.     set teIndex 0
  310.     
  311.     foreach err $l {
  312.         append lines "\"[file tail [lindex $err 0]]\"; " [format "Line %d: " [lindex $err 2]] [lindex $err 1] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞[lindex $err 0]∞[lindex $err 1]\r"
  313.     }
  314.  
  315.     new -n "* Compiler Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  316.  
  317.     insertText "(<cr> to go to error)\r-----\r" $lines
  318.     downBrowse
  319.     setWinInfo dirty 0
  320.     
  321. }
  322.  
  323.